home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / CRC.SWG / 0003_16 BIT CRC.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  88 lines
  1. {
  2.  The following is a Turbo/Quick Pascal Implementation of calculating
  3.  the XModem Type of 16-bit cyclic redundancy checking (CRC).
  4.  
  5.  Is there a preference For the language of the next CRC-16 example
  6.  (80x86 Assembly, BASIC, or C) ?
  7. }
  8.  
  9. (*******************************************************************)
  10. Program TPCRC16;    { Compiler: TurboPascal 4.0+ & QuickPascal 1.0+ }
  11. { Turbo Pascal 16-bit Cyclic Redundancy Checking (CRC) a.la. XModem }
  12. { Greg Vigneault, Box 7169, Station A, toronto, Canada M5W 1X8.     }
  13.  
  14. Const   Beep        = #7;                       { ASCII bell tone   }
  15. Type    bArray      = Array [1..$4000] of Byte; { define buffer     }
  16.         bPointer    = ^bArray;                  { Pointer to buffer }
  17. Var     DataPtr     : bPointer;                 { Pointer to data   }
  18.         fName       : String;                   { File name         }
  19.         fHandle     : File;                     { File handle       }
  20.         BytesIn     : Word;                     { For counting data }
  21.         CRC16       : Integer;                  { running CRC-16    }
  22.  
  23. {-------------------------------------------------------------------}
  24.  Procedure WriteHex( raw : Integer );   { display hexadecimal value }
  25.     Var ch      : Char;
  26.         shft    : Byte;
  27.     begin
  28.         if (raw = 0) then Write('0')            { if zero           }
  29.         else begin
  30.             shft := 16;                         { bit count         }
  31.             Repeat  { isolate each hex nibble, and convert to ASCII }
  32.                 DEC( shft, 4 );                 { shift by nibble   }
  33.                 ch := CHR( raw SHR shft and $F or orD('0') ); {0..9 }
  34.                 if (ch > '9') then inC( ch, 7 );              {A..F }
  35.                 Write( ch );                    { display the digit }
  36.             Until (shft = 0);
  37.         end;
  38.     end {WriteHex};
  39.  
  40. {-------------------------------------------------------------------}
  41.  Function UpdateCRC16(CRC       : Integer;      { CRC-16 to update  }
  42.                       InBuf     : bPointer;     { Pointer to data   }
  43.                       InLen     : Integer) :Integer;  { data count  }
  44.     Var Bit, ByteCount          : Integer;
  45.         Carry                   : Boolean;      { catch overflow    }
  46.     begin
  47.     For ByteCount := 1 to InLen do              { all data Bytes    }
  48.         For Bit := 7 doWNto 0 do begin          { 8 bits per Byte   }
  49.             Carry := CRC and $8000 <> 0;        { shift overlow?    }
  50.             CRC := CRC SHL 1 or InBuf^[ByteCount] SHR Bit and 1;
  51.             if Carry then CRC := CRC xor $1021; { apply polynomial  }
  52.         end; { For Bit & ByteCount }            { all Bytes & bits  }
  53.     UpdateCRC16 := CRC;                         { updated CRC-16    }
  54.     end {UpdateCRC16};
  55.  
  56. {-------------------------------------------------------------------}
  57. begin
  58.     if ( MaxAvail < Sizeof(bArray) ) then begin { check For memory  }
  59.         WriteLn( 'not enough memory!', Beep );
  60.         Halt(1);
  61.     end;
  62.     if (ParamCount <> 1) then begin             { File name input?  }
  63.         WriteLn( 'Use TPCRC16 <fName>', Beep );;
  64.         Halt(2);
  65.     end;
  66.     fName := ParamStr(1);                       { get File name     }
  67.     Assign( fHandle, fName );                   { open the File     }
  68.     {$i-} Reset( fHandle, 1 ); {$i+}            { open succeeded?   }
  69.     if (IoResult <> 0) then begin               { if not ...        }
  70.         WriteLn( 'File access ERRor', Beep );
  71.         Halt(3);
  72.     end;
  73.     New( DataPtr );                             { allocate memory   }
  74.     CRC16 := 0;                                 { initialize CRC-16 }
  75.     Repeat
  76.         BlockRead( fHandle, DataPtr^[1], Sizeof(bArray), BytesIn );
  77.         CRC16 := UpdateCRC16( CRC16, DataPtr, BytesIn );
  78.     Until (BytesIn <> Sizeof(bArray)) or Eof(fHandle);
  79.     Close( fHandle );                           { close input File  }
  80.     DataPtr^[1] := 0; DataPtr^[2] := 0;         { insert two nulls  }
  81.     CRC16 := UpdateCRC16( CRC16, DataPtr, 2 );  { For final calc    }
  82.     Dispose( DataPtr );                         { release memory    }
  83.     Write( 'The CRC-16 of File ', fName, ' is $' );
  84.     WriteHex( CRC16 );  WriteLn;
  85.  
  86. end {TPCRCXMO}.
  87. (*********************************************************************)
  88.